home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Language/OS - Multiplatform Resource Library
/
LANGUAGE OS.iso
/
lisp
/
eulisp
/
mpfeel.lha
/
MPFeel
/
Plurals
/
mp_vector.m
< prev
next >
Wrap
Text File
|
1992-07-20
|
12KB
|
442 lines
/*
* Plurals
*
* Author: S.C.Merrall
*
* File: mp_vector.m
*
* Contents: make_vector
* vector_ref
* vector_set
* vector_length
* vector_merge
*
* Description: Functions for creating and accessing the contents
* of vectors
*
* Change History:
*
* Date Name Comment
* -------- ---- -------
* 15:05:91 SCM Created
*
*/
#include <mpl.h>
#include <stdio.h>
#include "constant.h"
#include "mp_object.h"
#include "mp_debug.h"
#include "mp_type.h"
#include "mp_gc.h"
/*----------------------------------------------------------------------------*
* Function : make_vector
*
* Parameters : MP_PluralHeap MPPH_length: Size of vector
* MP_PluralHeap MPPH_vector: Resulting vectors
*
* Description: Allocate a vector of 'length' elements, each element is
* initially set to nil
*
* Result : int: SUCESS/FAIL
*---------------------------------------------------------------------------*/
#ifdef __STDC__
int make_vector( MP_PluralHeap MPPH_length, MP_PluralHeap MPPH_vector )
#else
int make_vector( MPPH_length, MPPH_vector )
MP_PluralHeap MPPH_length;
MP_PluralHeap MPPH_vector;
#endif
{
plural natural *plural new_vector;
plural int length;
plural int i;
DBG_CALL("make_vector");
DBG_ARGS(fprintf(dbg,"length=????, MPPH_vector=%04x",MPPH_vector));
/* Check all the lengths are integers */
if (globalor(OA_info(MPPH_length) != INTEGER)) {
DBG_FAIL(fprintf(dbg,"FAIL: Not all the lengths are integers"));
return FAIL;
}
length = *(plural int *plural) OA_data(MPPH_length);
/* Allocate space for new vectors */
if (mp_alloc((plural int) MP_VECTOR, length, MPPH_vector) == FAIL) {
DBG_FAIL(fprintf(dbg,"FAIL: Unable to allocate space"));
return FAIL;
}
new_vector = (plural natural *plural) OA_data(MPPH_vector);
for (i=0; i < length; i++) { /* Initialise all elements to NIL */
*(new_vector + i) = NIL;
}
DBG_EXIT(fprintf(dbg,"SUCCESS"));
return SUCCESS;
}
/*----------------------------------------------------------------------------*
* Function : vector_set
*
* Parameters : MP_PluralHeap MPPH_vector: MasPar Plural Heap object,
* handle on the vectors
* MP_PluralHeap MPPH_index: Index of the vector which is
* to be updated.
* MP_PluralHeap MPPH_value: MasPar Plural Heap object,
* handle on Heap space of new
* value at that index.
*
* Description: Sets the indexth element of the vector MPPH_vector to
* be MPPH_value. Note that each element of MPPH_value can be
* a different object and that each elemnt of index can have
* a different value. These are full parallel versions!
*
* Result : int: SUCCESS/FAIL
*---------------------------------------------------------------------------*/
#ifdef __STDC__
int vector_set( MP_PluralHeap MPPH_vector, MP_PluralHeap index,
MP_PluralHeap MPPH_value )
#else
int vector_set( MPPH_vector, MPPH_index, MPPH_value )
MP_PluralHeap MPPH_vector;
MP_PluralHeap MPPH_index;
MP_PluralHeap MPPH_value;
#endif
{
plural natural *plural vector;
plural int index;
DBG_CALL("vector_set");
DBG_ARGS(fprintf(dbg,"MPPH_vector=????, MPPH_index=????, MPPH_value=????"));
/* Check these are all vectors */
if (globalor(OA_info(MPPH_vector) != MP_VECTOR)) {
DBG_FAIL(fprintf(dbg,"FAIL: Not all these are vectors"));
return FAIL;
}
/* Check index is an integer and within the range of all the vectors */
if (globalor(OA_info(MPPH_index) != INTEGER)) {
DBG_FAIL(fprintf(dbg,"FAIL: Not all the indexes are integers"));
return FAIL;
}
index = *(plural int *plural) OA_data(MPPH_index);
if (globalor((MP_LENGTH(OA_space(MPPH_vector)) <= index) ||
(index < 0))) {
DBG_FAIL(fprintf(dbg,"FAIL: index is too large for some of the vectors"));
return FAIL;
}
vector = (plural natural *plural) OA_data(MPPH_vector);
*(vector + index) = OA_offsets(MPPH_value);
DBG_EXIT(fprintf(dbg,"SUCCESS"));
return SUCCESS;
}
/*----------------------------------------------------------------------------*
* Function : vector_ref
*
* Parameters : MP_PluralHeap MPPH_vector: MasPar Plural Heap object,
* handle on the vectors
* MP_PluralHeap index: Index of the vector which is
* to be updated.
* MP_PluralHeap MPPH_result: MasPar Plural Heap object,
* handle on indexth objects
*
* Description: Refs the indexth element of the vector MPPH_vector into
* MPPH_value.
*
* Result : int: SUCCESS/FAIL
*---------------------------------------------------------------------------*/
#ifdef __STDC__
int vector_ref( MP_PluralHeap MPPH_vector, MP_PluralHeap MPPH_index,
MP_PluralHeap MPPH_result )
#else
int vector_ref( MPPH_vector, MPPH_index, MPPH_result )
MP_PluralHeap MPPH_vector;
MP_PluralHeap MPPH_index;
MP_PluralHeap MPPH_result;
#endif
{
plural natural *plural vector;
plural int index;
DBG_CALL("vector_ref");
DBG_ARGS(fprintf(dbg,"MPPH_vector=????, index=????, MPPH_result=????"));
/* Check these are all vectors */
if (globalor(OA_info(MPPH_vector) != MP_VECTOR)) {
DBG_FAIL(fprintf(dbg,"FAIL: Not all these are vectors"));
return FAIL;
}
/* Check index is an integer and within the range of all the vectors */
if (globalor(OA_info(MPPH_index) != INTEGER)) {
DBG_FAIL(fprintf(dbg,"FAIL: Not all the indexes are inetegers"));
return FAIL;
}
index = *(plural int *plural) OA_data(MPPH_index);
if (globalor((MP_LENGTH(OA_space(MPPH_vector)) <= index) ||
(index < 0))) {
DBG_FAIL(fprintf(dbg,"FAIL: index out of some of the vectors range"));
return FAIL;
}
vector = (plural natural *plural) OA_data(MPPH_vector);
OA_offsets(MPPH_result) = *(vector + index);
DBG_EXIT(fprintf(dbg,"SUCCESS"));
return SUCCESS;
}
/*----------------------------------------------------------------------------*
* Function : vector_length
*
* Parameters : MP_PluralHeap MPPH_vector: Handles on the vectors heap
* space and
* MP_PluralHeap MPPH_result: where the lengths are to go
*
* Description: Extracts and returns the integer length of each of the
* vectors
*
* Result : int: FAIL/SUCCESS
*---------------------------------------------------------------------------*/
#ifdef __STDC__
int vector_length( MP_PluralHeap MPPH_vector, MP_PluralHeap MPPH_result )
#else
int vector_length( MPPH_vector, MPPH_result )
MP_PluralHeap MPPH_vector;
MP_PluralHeap MPPH_result;
#endif
{
plural int *plural length;
DBG_CALL("vector_length");
DBG_ARGS(fprintf(dbg,"MPPH_vector=????, MPPH_result=????"));
/* Check these are all vectors */
if (OA_info(MPPH_vector) != MP_VECTOR) {
DBG_FAIL(fprintf(dbg,"FAIL: Not all od these are vectors"));
return FAIL;
}
/* Allocate space for the length to go in */
if (mp_alloc((plural int) INTEGER, (plural int) 1, MPPH_result) == FAIL) {
DBG_FAIL(fprintf(dbg,"FAIL: Unable to allocate space for the lengths"));
return FAIL;
}
length = (plural int *plural) OA_data(MPPH_result);
*length = MP_LENGTH(OA_space(MPPH_vector));
DBG_EXIT(fprintf(dbg,"SUCCESS"));
return SUCCESS;
}
/* Experimental hacks for new processor management mechanism which */
/* supports overloading of processors at the back end instruction */
/* level */
/*----------------------------------------------------------------------------*
* Function : vector_merge
*
* Parameters : MP_PluralHeap MPPH_set1: Handles on the keys and
* MP_PluralHeap MPPH_set21: data vectors which are
* MP_PluralHeap MPPH_result: to be merge sorted
*
* Description: This function is a bit of hack but I think is justified.
* We merge sort the two key vectors, at the same time we do
* identical operations on the two data vectors, this will
* allow us to join sets of (virtual) processors and their
* values efficiently.
*
* Result : int FAIL/SUCCESS
*---------------------------------------------------------------------------*/
#ifdef __STDC__
int vector_merge( MP_PluralHeap MPPH_set1, MP_PluralHeap MPPH_set2,
MP_PluralHeap MPPH_result )
#else
int vector_merge( MPPH_set1, MPPH_set2, MPPH_result )
MP_PluralHeap MPPH_set1;
MP_PluralHeap MPPH_set2;
MP_PluralHeap MPPH_result;
#endif
{
plural natural *plural key1;
plural natural *plural key2;
plural natural *plural to = (plural natural *plural) scratch;
plural natural *plural from1;
plural natural *plural from2;
plural natural *plural data1, *plural data2;
plural natural *plural last1;
plural natural *plural last2;
plural int val1, val2;
int to_data_offset;
DBG_CALL("vector_merge");
DBG_ARGS(DBG_PARG("MPPH_set1","%x ",MPPH_set1);DBG_PARG("MPPH_set2","%x ",MPPH_set2);DBG_PARG("MPPH_result","%x ",MPPH_result));
to_data_offset = SCRATCH_MEMORY_SIZE/(2*sizeof(natural));
/* We are expecting a cons cell of key vector and data vector, so we */
/* take the car (in a hackery way) to get the key. */
key1 = (plural natural *plural) OA_data(MPPH_set1);
key2 = (plural natural *plural) OA_data(MPPH_set2);
from1 = (plural natural *plural) OA_data(key1);
from2 = (plural natural *plural) OA_data(key2);
last1 = from1 + MP_LENGTH(OA_space(key1));
last2 = from2 + MP_LENGTH(OA_space(key2));
data1 = (plural natural *plural) OA_data((plural natural *plural) (OA_data(MPPH_set1) + sizeof(natural)));
data2 = (plural natural *plural) OA_data((plural natural *plural) (OA_data(MPPH_set2) + sizeof(natural)));
while ((from1 < last1) || (from2 < last2)) {
val1 = * (plural int *plural) OA_data( (plural natural *plural) (OA_data(from1) +2));
val2 = * (plural int *plural) OA_data( (plural natural *plural) (OA_data(from2) + 2));
/* val1 = * (plural int *plural) OA_data(from1);
val2 = * (plural int *plural) OA_data(from2);*/
DEBUG(DBG_PARG("val1"," %d",val1));
DEBUG(DBG_PARG("val2"," %d",val2));
if (val1 == val2) {
*to = *(from1++);
from2++;
*(to + to_data_offset) = *(data1++);
data2++;
}
else if (val1 < val2) {
*to = *(from1++);
*(to + to_data_offset) = *(data1++);
}
else {
*to = *(from2++);
*(to + to_data_offset) = *(data2++);
}
to++;
if (from1 >= last1) {
pp_memcpy((plural char *plural) to,
(plural char *plural) from2,
(plural char *plural) last2 - (plural char *plural) from2);
pp_memcpy((plural char *plural) (to + to_data_offset),
(plural char *plural) data2,
(plural char *plural) last2 - (plural char *plural) from2);
to = to + (last2 - from2);
from2 = last2;
}
else if (from2 >= last2) {
pp_memcpy((plural char *plural) to,
(plural char *plural) from1,
((plural char *plural) last1 - (plural char *plural) from1));
pp_memcpy((plural char *plural) (to + to_data_offset),
(plural char *plural) data1,
((plural char *plural) last1 - (plural char *plural) from1));
to = to + (last1 - from1);
from1 = last1;
}
}
if (mp_alloc((plural int) MP_CONS, (plural int) 1, MPPH_result) == FAIL) {
DBG_FAIL(fprintf(dbg,"FAIL: Unable to allocate cons for merge "));
return FAIL;
}
if (mp_alloc((plural int) MP_VECTOR, to - (plural natural *plural) scratch,
(plural natural *plural) OA_data(MPPH_result)) == FAIL) {
DBG_FAIL(fprintf(dbg,"FAIL: Unable to allocate vector for merge key"));
return FAIL;
}
if (mp_alloc((plural int) MP_VECTOR, to - (plural natural *plural) scratch,
((plural natural *plural) OA_data(MPPH_result)) +1) == FAIL) {
DBG_FAIL(fprintf(dbg,"FAIL: Unable to allocate vector for merge data"));
return FAIL;
}
pp_memcpy(OA_data((plural natural *plural) OA_data(MPPH_result)),
(plural natural *plural) scratch,
((plural char *plural) to) - scratch);
pp_memcpy(OA_data((plural natural *plural) (OA_data(MPPH_result) + sizeof(natural))),
((plural char *plural) scratch) +(to_data_offset*sizeof(natural)),
((plural char *plural) to) - scratch);
DBG_EXIT(fprintf(dbg,"SUCCESS"));
return SUCCESS;
}